home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / kaleido.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-20  |  2.8 KB  |  120 lines
  1. {
  2.  ******************************************************************************
  3.  * KALEIDO - Kaleioscope line drawing demo.                      *
  4.  *                                          *
  5.  * Written for GRAFIX by:  Joseph A. Albrecht                      *
  6.  *                                          *
  7.  * Press F1 to pause program                              *
  8.  * Press F2 to clear the screen                              *
  9.  * Press F10 to toggle between 320 and 640 graphic modes              *
  10.  * Press ESC to exit program                              *
  11.  ******************************************************************************
  12. }
  13.  
  14. PROGRAM Kaleideoscope;
  15.  
  16. USES
  17.   Grafix,
  18.   Crt;
  19.  
  20. VAR
  21.   MX, MY, M, MaxDelta, MaxColor, X1, Y1, X2, Y2, Graphics: INTEGER;
  22.   LC, XV1, XV2, YV1, YV2, XA, XB, YA, YB: INTEGER;
  23.   Leave, Tandy11: BOOLEAN;
  24.   Ch : CHAR;
  25.  
  26. FUNCTION Rnd (Max: INTEGER): INTEGER;
  27.  
  28. BEGIN
  29.  
  30.   Rnd := Random(Max) + 1;
  31.  
  32. END;
  33.  
  34. {Mainline}
  35. BEGIN
  36.  
  37.   MX := 160;
  38.   MY := 100;
  39.   M := 100;
  40.   MaxDelta := 7;
  41.   MaxColor := 15;
  42.   Graphics := 320;
  43.   MediumGraphics;
  44.   GetTandy11(Tandy11);
  45.   Leave := False;
  46.   WHILE (M = 100) DO
  47.     BEGIN
  48.       Randomize;
  49.       ClearScreen;
  50.       X1 := Rnd(M) + 1;
  51.       X2 := Rnd(M) + 1;
  52.       Y1 := Rnd(X1);
  53.       Y2 := Rnd(X2);
  54.       WHILE (M = 100) DO
  55.     BEGIN
  56.       LC := Rnd(MaxColor); {Insure good color separation}
  57.       LC := Rnd(MaxColor);
  58.           SetPlotColor(LC);
  59.       XV1 := Rnd(11) - 5;
  60.       XV2 := Rnd(11) - 5;
  61.       YV1 := Rnd(11) - 5;
  62.       YV2 := Rnd(11) - 5;
  63.       WHILE (Rnd(10) > 1) DO
  64.         BEGIN
  65.           XA := (X1 * 9) Div MaxDelta;
  66.           XB := (X2 * 9) Div MaxDelta;
  67.           YA := (Y1 * 9) Div MaxDelta;
  68.           YB := (Y2 * 9) Div MaxDelta;
  69.           ExtLine(MX + XB, MY - Y2, MX + XA, MY - Y1);
  70.           ExtLine(MX - YB, MY + X2, MX - YA, MY + X1);
  71.           ExtLine(MX - XB, MY - Y2, MX - XA, MY - Y1);
  72.           ExtLine(MX - YB, MY - X2, MX - YA, MY - X1);
  73.           ExtLine(MX - XB, MY + Y2, MX - XA, MY + Y1);
  74.           ExtLine(MX + YB, MY - X2, MX + YA, MY - X1);
  75.           ExtLine(MX + XB, MY + Y2, MX + XA, MY + Y1);
  76.           ExtLine(MX + YB, MY + X2, MX + YA, MY + X1);
  77.           X1 := Abs((X1 + XV1) Mod M);
  78.           Y1 := Abs((Y1 + YV1) Mod M);
  79.           X2 := Abs((X2 + XV2) Mod M);
  80.           Y2 := Abs((Y2 + YV2) Mod M);
  81.         END;
  82.       Ch := #255;
  83.       IF KeyPressed THEN
  84.         Ch := ReadKey;
  85.       IF Ch = #27 THEN
  86.         BEGIN
  87.           ExitGraphics;
  88.           M := 0;
  89.           Leave := True;
  90.         END;
  91.     IF Ch = #00 THEN
  92.       BEGIN
  93.         Ch := ReadKey;
  94.         IF Ch = #59 THEN WaitKey;
  95.         IF Ch = #60 THEN M := 0;
  96.         IF ((Ch = #68) AND (Tandy11 = True)) THEN
  97.           BEGIN
  98.         M := 0;
  99.         IF Graphics = 320 THEN
  100.           BEGIN
  101.             Graphics := 640;
  102.             MX := 320;
  103.             MaxDelta := 4;
  104.             HighGraphics;
  105.           END
  106.         ELSE
  107.           BEGIN
  108.             Graphics := 320;
  109.             MX := 160;
  110.             MaxDelta := 7;
  111.             MediumGraphics;
  112.           END;
  113.           END;
  114.       END;
  115.       END;
  116.       IF Leave = False THEN M := 100;
  117.     END;
  118.  
  119. END.
  120.